home *** CD-ROM | disk | FTP | other *** search
/ Reverse Code Engineering RCE CD +sandman 2000 / ReverseCodeEngineeringRceCdsandman2000.iso / RCE / Library / Manuels & Misc / Assembly / AOA.ZIP / CH02 / OPTIMIZE / OPTIMIZE.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-01-06  |  25.1 KB  |  857 lines
  1. (************************************************************************)
  2. (*                                    *)
  3. (* Optimize-                                *)
  4. (*                                    *)
  5. (* Randall L. Hyde                            *)
  6. (* 12/20/95                                *)
  7. (* For use with "The Art of Assembly Language Programming."        *)
  8. (* Copyright 1995, All Rights Reserved.                    *)
  9. (*                                    *)
  10. (* This program lets the user enter a logic equation.  The program will    *)
  11. (* convert the logic equation to a truth table and its canonical sum of    *)
  12. (* minterms form.  The program will then optimize the equation (to pro-    *)
  13. (* duce a minimal number of terms) using the carnot map method.        *)
  14. (*                                    *)
  15. (************************************************************************)
  16.  
  17.  
  18. unit Optimize;
  19.  
  20. interface
  21.  
  22. uses
  23.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  24.   Forms, Dialogs, StdCtrls, Aboutu, ExtCtrls;
  25.  
  26. type
  27.   TEqnOptimize = class(TForm)
  28.  
  29.     PrintBtn: TButton;     { Buttons appearing on the form        }
  30.     AboutBtn: TButton;
  31.     ExitBtn: TButton;
  32.     OptimizeBtn: TButton;
  33.  
  34.     CanonicalPanel: TGroupBox;
  35.     OptimizedPanel: TGroupBox;
  36.     PrintDialog: TPrintDialog;
  37.  
  38.     LogEqn: TEdit;    {Logic equation input box and label    }
  39.     LogEqnLbl: TLabel;
  40.  
  41.     Eqn1: TLabel;    { Strings that hold the canonical form    }
  42.     Eqn2: TLabel;
  43.  
  44.     Eqn3: TLabel;       { Strings that hold the optimized form    }
  45.     Eqn4: TLabel;
  46.  
  47.     dc00: TLabel;    { Labels around the truth map    }
  48.     dc01: TLabel;
  49.     dc11: TLabel;
  50.     dc10: TLabel;
  51.     ba00: TLabel;
  52.     ba01: TLabel;
  53.     ba11: TLabel;
  54.     ba10: TLabel;
  55.  
  56.     tt00: TPanel;    { Rectangles in the truth map }
  57.     tt01: TPanel;
  58.     tt02: TPanel;
  59.     tt03: TPanel;
  60.     tt10: TPanel;
  61.     tt11: TPanel;
  62.     tt12: TPanel;
  63.     tt13: TPanel;
  64.     tt20: TPanel;
  65.     tt21: TPanel;
  66.     tt22: TPanel;
  67.     tt23: TPanel;
  68.     tt30: TPanel;
  69.     tt31: TPanel;
  70.     tt32: TPanel;
  71.     tt33: TPanel;
  72.     StepBtn: TButton;
  73.  
  74.     procedure PrintBtnClick(Sender: TObject);
  75.     procedure ExitBtnClick(Sender: TObject);
  76.     procedure AboutBtnClick(Sender: TObject);
  77.     procedure LogEqnChange(Sender: TObject);
  78.     procedure FormCreate(Sender: TObject);
  79.     procedure OptimizeBtnClick(Sender: TObject);
  80.     procedure StepBtnClick(Sender: TObject);
  81.   private
  82.     { Private declarations }
  83.   public
  84.     { Public declarations }
  85.   end;
  86.  
  87. var
  88.   EqnOptimize: TEqnOptimize;
  89.  
  90. implementation
  91.  
  92. { Set constants for the optimization operation.     These sets group the    }
  93. { cells in the truth map that combine to form simpler terms.        }
  94.  
  95. type TblSet = set of 0..15;
  96. const
  97.     { If the truth table is equal to the "Full" set, then we have    }
  98.         { the logic function "F=1".                    }
  99.  
  100.     Full = [0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15];
  101.  
  102.         { The TermSets list is a list of sets corresponding to the    }
  103.         { cells in the truth map that contain all ones for the terms     }
  104.         { that we can optimize away.                    }
  105.  
  106.         TermSets : array[0..79] of TblSet =
  107.                (
  108.  
  109.                    { Terms containing a single variable, e.g., A, A', B,    }
  110.                 { B', and so on.                    }
  111.  
  112.             [0,1,2,3,4,5,6,7],
  113.                 [4,5,6,7,8,9,10,11],
  114.                 [8,9,10,11,12,13,14,15],
  115.                 [12,13,14,15,0,1,2,3],
  116.                 [0,1,4,5,8,9,12,13],
  117.                 [1,2,5,6,9,10,13,14],
  118.                 [2,3,6,7,10,11,14,15],
  119.                 [3,0,7,4,11,8,15,12],
  120.  
  121.                 { Terms containing two variables, e.g., AB, AB', A'B,    }
  122.                 { and so on.  This first set of eight values corres-    }
  123.                 { ponds to the groups of four vertical or horizontal    }
  124.                 { values.  The next group of 16 sets corresponds to the    }
  125.                 { groups of four values that form a 2x2 square in the    }
  126.                 { truth map.                        }
  127.  
  128.             [0,1,2,3],        [4,5,6,7],
  129.                 [8,9,10,11],        [12,13,14,15],
  130.                 [0,4,8,12],        [1,5,9,13],
  131.                 [2,6,10,14],        [3,7,11,15],
  132.  
  133.                 [0,1,4,5],        [1,2,5,6],
  134.                 [2,3,6,7],        [3,0,7,4],
  135.  
  136.                 [4,5,8,9],        [5,6,9,10],
  137.                 [6,7,10,11],        [7,4,11,8],
  138.  
  139.                 [8,9,12,13],        [9,10,13,14],
  140.                 [10,11,14,15],        [11,8,15,12],
  141.  
  142.                 [12,13,0,1],        [13,14,1,2],
  143.                 [14,15,2,3],        [15,12,3,0],
  144.  
  145.                 { Terms containing three variables, e.g., ABC, ABC',    }
  146.                 { and so on.                        }
  147.  
  148.                    [0,1],        [1,2],        [2,3],        [3,0],
  149.                 [4,5],        [5,6],        [6,7],        [7,4],
  150.                 [8,9],        [9,10],        [10,11],    [11,8],
  151.                 [12,13],    [13,14],    [14,15],    [15,12],
  152.  
  153.                 [0,4],        [4,8],        [8,12],        [12,0],
  154.                 [1,5],        [5,9],        [9,13],        [13,1],
  155.                 [2,6],        [6,10],        [10,14],    [14,2],
  156.                 [3,7],        [7,11],        [11,15],    [15,3],
  157.  
  158.  
  159.                 { Minterms- Those terms containing four variables.    }
  160.  
  161.                 [0],    [1],    [2],    [3],
  162.                 [4],    [5],    [6],    [7],
  163.                 [8],    [9],    [10],    [11],
  164.                 [12],    [13],    [14],    [15]
  165.                );
  166.  
  167.  
  168.         { Here are the corresponding strings we output for the patterns    }
  169.         { above.                            }
  170.  
  171.  
  172.         TermStrs: array [0..79] of string[8] =
  173.                    ('D''', 'C', 'D', 'C''',
  174.                  'B''', 'A', 'B', 'A''',
  175.  
  176.              'D''C''', 'D''C', 'DC',   'DC''',
  177.                  'B''A''', 'B''A', 'BA',   'BA''',
  178.                  'D''B''', 'D''A', 'D''B', 'D''A''',
  179.                  'CB''',   'CA',   'CB',   'CA''',
  180.                  'DB''',   'DA',   'DB',   'DA''',
  181.                  'C''B''', 'C''A', 'C''B', 'C''A''',
  182.  
  183.          'D''C''B''',    'D''C''A',    'D''C''B',    'D''C''A''',
  184.          'D''CB''',    'D''CA',    'D''CB',    'D''CA''',
  185.          'DCB''',    'DCA',        'DCB',        'DCA''',
  186.          'DC''B''',    'DC''A',    'DC''B',    'DC''A''',
  187.  
  188.                  'B''A''D''',    'B''A''C',    'B''A''D',    'B''A''C''',
  189.                  'B''AD''',    'B''AC',    'B''AD',    'B''AC''',
  190.                  'BAD''',    'BAC',        'BAD',        'BAC''',
  191.                  'BA''D''',    'BA''C',    'BA''D',    'BA''C''',
  192.  
  193.                     'D''C''B''A''','D''C''B''A',    'D''C''BA',    'D''C''BA''',
  194.                     'D''CB''A''',    'D''CB''A',    'DC''BA',    'DC''BA''',
  195.                     'DCB''A''',    'DCB''A',    'DCBA',        'DCBA''',
  196.                     'DC''B''A''',    'DC''B''A',    'DC''BA',    'DC''BA'''
  197.                 );
  198.  
  199.  
  200.  
  201.         { Transpose converts truth table indicies into truth map index-    }
  202.         { es.  In reality, this converts binary numbers to a gray code.    }
  203.  
  204.         Transpose : array [0..15] of integer = (0, 1, 3, 2,
  205.                             4, 5, 7, 6,
  206.                                                 12,13,15,14,
  207.                                                 8, 9, 11, 10);
  208.  
  209. var
  210.  
  211.     { Global, static, variables that the iterator uses to step    }
  212.         { through an optimization.                    }
  213.  
  214.     IterIndex:    integer;
  215.         FirstStep:    boolean;
  216.  
  217.         StepSet,
  218.         StepLeft,
  219.         LastSet        :TblSet;
  220.  
  221.     { The following array provides convenient access to the truth map }
  222.  
  223.     tt: array[0..1,0..1,0..1,0..1] of TPanel;
  224.  
  225. {$R *.DFM}
  226.  
  227.  
  228.  
  229.  
  230. { ApndStr-    item contains '0' or '1' -- the character in the}
  231. {        current truth table cell.  theStr is a string    }
  232. {        of characters to append to the equation if item    }
  233. {        is equal to '1'.                }
  234.  
  235. procedure ApndStr(item:char; const theStr:string;
  236.           var Eqn1, Eqn2:TLabel);
  237. begin
  238.  
  239.  
  240.         { To make everything fit on our form, we have to break    }
  241.         { the equation up into two lines.  If the first line    }
  242.         { hits 66 characters, append the characters to the end    }
  243.         { of the second string.                    }
  244.  
  245.       if (length(eqn1.Caption) < 66) then begin
  246.  
  247.            { If we are appending to the end of EQN1, we have to    }
  248.            { check to see if the string's length is zero.  If    }
  249.            { not, then we need to stick ' + ' between the    }
  250.            { existing string and the string we are appending.    }
  251.            { If the string length is zero, this is the first    }
  252.            { minterm so we don't prepend the ' + '.        }
  253.  
  254.            if (item = '1') then
  255.             if (length(eqn1.Caption) = 0) then
  256.                      eqn1.Caption := theStr
  257.             else eqn1.Caption :=  eqn1.Caption + ' + ' + theStr;
  258.       end
  259.       else if (item = '1') then
  260.             eqn2.Caption :=  eqn2.Caption + ' + ' + theStr;
  261.  
  262. end;
  263.  
  264.  
  265.  
  266. (* ComputeEqn-    Computes the logic equation string from the current    *)
  267. (*         truth table entries.                    *)
  268.  
  269. procedure ComputeEqn;
  270. begin
  271.  
  272.     with EqnOptimize do begin
  273.  
  274.  
  275.         eqn1.Caption := '';
  276.         eqn2.Caption := '';
  277.  
  278.  
  279.         { Build the logic equation from all the squares    }
  280.         { in the truth table.                }
  281.  
  282.         ApndStr(tt00.Caption[1],'D''C''B''A''',Eqn1, Eqn2);
  283.         ApndStr(tt01.Caption[1],'D''C''B''A',Eqn1, Eqn2);
  284.         ApndStr(tt02.Caption[1], 'D''C''BA',Eqn1, Eqn2);
  285.         ApndStr(tt03.Caption[1], 'D''C''BA''',Eqn1, Eqn2);
  286.  
  287.         ApndStr(tt10.Caption[1],'D''CB''A''',Eqn1, Eqn2);
  288.         ApndStr(tt11.Caption[1],'D''CB''A',Eqn1, Eqn2);
  289.         ApndStr(tt12.Caption[1], 'D''CBA',Eqn1, Eqn2);
  290.         ApndStr(tt13.Caption[1], 'D''CBA''',Eqn1, Eqn2);
  291.  
  292.         ApndStr(tt20.Caption[1],'DCB''A''',Eqn1, Eqn2);
  293.         ApndStr(tt21.Caption[1],'DCB''A',Eqn1, Eqn2);
  294.         ApndStr(tt22.Caption[1], 'DCBA',Eqn1, Eqn2);
  295.         ApndStr(tt23.Caption[1], 'DCBA''',Eqn1, Eqn2);
  296.  
  297.         ApndStr(tt30.Caption[1],'DC''B''A''',Eqn1, Eqn2);
  298.         ApndStr(tt31.Caption[1],'DC''B''A',Eqn1, Eqn2);
  299.         ApndStr(tt32.Caption[1], 'DC''BA',Eqn1, Eqn2);
  300.         ApndStr(tt33.Caption[1], 'DC''BA''',Eqn1, Eqn2);
  301.  
  302.  
  303.         { If after all the above the string is empty, then we've got a    }
  304.     { truth table that contains all zeros.  Handle that special    }
  305.         { case down here.                        }
  306.  
  307.         if (length(eqn1.Caption) = 0) then
  308.            eqn1.Caption := '0';
  309.         Eqn1.Caption := 'F= ' + Eqn1.Caption;
  310.  
  311.     end;
  312.  
  313. end;
  314.  
  315.  
  316. procedure RestoreMap;
  317. var a,b,c,d:integer;
  318. begin
  319.  
  320.         { Restore the colors on the truth map.                }
  321.  
  322.     for d := 0 to 1 do
  323.             for c := 0 to 1 do
  324.                 for b := 0 to 1 do
  325.                     for a := 0 to 1 do
  326.                     begin
  327.  
  328.                         tt[d,c,b,a].Color := clBtnFace;
  329.  
  330.                     end;
  331. end;
  332.  
  333.  
  334.  
  335. { InitIter-Initializes the iterator for the first optimization step.    }
  336. {          This code enables the step button, sets all the truth table    }
  337. {        squares to gray, and sets up the global variables for the    }
  338. {       very first optimization operation.                }
  339.  
  340. procedure InitIter;
  341. var
  342.     d,c,b,a:integer;
  343. begin
  344.  
  345.     with EqnOptimize do
  346.     begin
  347.  
  348.     { Initialize global variables.                    }
  349.  
  350.     StepBtn.Enabled := true;
  351.         IterIndex := 0;
  352.         LastSet := [];
  353.  
  354.         { Restore the colors on the truth map.                }
  355.  
  356.     RestoreMap;
  357.  
  358.         { Compute the set of values in the truth map             }
  359.  
  360.         Eqn3.Caption := '';
  361.         Eqn4.Caption := '';
  362.         IterIndex := 0;
  363.         StepSet := [];
  364.         for d := 0 to 1 do
  365.             for c := 0 to 1 do
  366.                 for b := 0 to 1 do
  367.                     for a := 0 to 1 do
  368.                         if (tt[d,c,b,a].Caption = '1') then
  369.                            StepSet := StepSet + [ ((b*2+a) xor b) +
  370.                                            ((d*2+c) xor d)*4
  371.                                                 ];
  372.         StepLeft := StepSet;
  373.  
  374.         { Check for two special cases: F=1 and F=0.  The optimization    }
  375.         { algorithm cannot handle F=0 and this seems like the most    }
  376.         { appropriate place to handle F=1.  So handle these two special    }
  377.         { cases here.                            }
  378.  
  379.         if (StepSet = Full) then
  380.         begin
  381.  
  382.             Eqn3.Caption := 'F = 1';
  383.                 StepSet := [];
  384.  
  385.         end
  386.         else if (StepSet = []) then Eqn3.Caption := 'F = 0';
  387.     end;
  388.  
  389.     { Prevent a call to this routine the next time the user presses    }
  390.     { the "Step" button.                        }
  391.  
  392.     FirstStep := false;
  393.  
  394. end;
  395.  
  396.  
  397. { StepBtnClick- This event does a single optimization operation.  Each    }
  398. { time the user presses the "Step" button, this code does a single    }
  399. { optimization operation;  that is, it locates a single unprocessed    }
  400. { group of ones in the truth map and optimizes them to their appropri-    }
  401. { ate term.  It highlights the optimized group so the user can easily    }
  402. { following the optimization process.  This program must call InitIter    }
  403. { prior to the first call of this routine.  In general, that call    }
  404. { occurs in the event handler for the "Optimize" button.        }
  405.  
  406. procedure TEqnOptimize.StepBtnClick(Sender: TObject);
  407. var
  408.     a,b,c,d, i:integer;
  409. begin
  410.  
  411.     { On the first call to this event handler (after the user presses    }
  412.     { the "Optimize" button), we need to initialize the iterator.  The    }
  413.     { FirstStep flag determines whether this is the first call after    }
  414.     { the user presses optimize.                    }
  415.  
  416.     if (FirstStep) then InitIter;
  417.  
  418.     with EqnOptimize do begin
  419.  
  420.         { The user actually has to press the "Step" button twice for    }
  421.         { each optimization step.  On the second press, the following    }
  422.         { code turns the squares processed on the previous depression    }
  423.         { to dark green.  This helps visually convey the process to     }
  424.         { the user.                            }
  425.  
  426.         if (LastSet <> []) then
  427.         begin
  428.  
  429.             for i := 0 to 15 do
  430.                     if (Transpose[i] in LastSet) then
  431.                         tt[i shr 3, (i shr 2) and 1,
  432.                             (i shr 1) and 1, i and 1].Color :=
  433.                             clgreen;
  434.                 LastSet := [];
  435.  
  436.         end
  437.  
  438.         { The following code executes on the first press of each pair    }
  439.         { of "Step" button depressions.  It checks to see if there is    }
  440.         { any work left to do and if so, it does exactly one optimiza-    }
  441.         { tion step.                            }
  442.  
  443.         else if (StepLeft <> []) then
  444.         begin
  445.  
  446.             { IterIndex should always be less than 80, this is just    }
  447.                 { a sanity check.                    }
  448.  
  449.                 while (IterIndex < 80) do
  450.                 begin
  451.  
  452.                     { If the current set of unprocessed squares    }
  453.                         { matches one of the patterns we need to process}
  454.                         { then add the appropriate term to our logic    }
  455.                         { equation.                    }
  456.  
  457.                     if ((TermSets[IterIndex] <= StepSet) and
  458.                            ((TermSets[IterIndex] * StepLeft) <> [])) then begin
  459.  
  460.                             ApndStr('1',TermStrs[IterIndex],Eqn3,Eqn4);
  461.  
  462.                                 { On the first step, we need to prepend    }
  463.                                 { the string "F = " to our logic eqn.    }
  464.                                 { The following if statement handles    }
  465.                                 { this chore.                }
  466.  
  467.                                 if (Eqn3.Caption[1] <> 'F') then
  468.                                     Eqn3.Caption := 'F = ' + Eqn3.Caption;
  469.  
  470.                                 { Remove the group we just processed    }
  471.                                 { from the truth map cells we've still    }
  472.                                 { got to process.            }
  473.  
  474.                                 StepLeft := StepLeft - TermSets[IterIndex];
  475.  
  476.                                 { Turn the cells we just processed to     }
  477.                                 { a bright, light, blue color (aqua).    }
  478.                                 { This lets the user see which cells    }
  479.                                 { correspond to the term we just ap-    }
  480.                                 { pended to the end of the equation.    }
  481.  
  482.                                 for i := 0 to 15 do
  483.                                     if (Transpose[i] in
  484.                                             TermSets[IterIndex]) then
  485.                                         tt[i shr 3, (i shr 2) and 1,
  486.                                            (i shr 1) and 1, i and 1].Color :=
  487.                                                claqua;
  488.  
  489.                                 { Save this group of cells so we can    }
  490.                                 { turn them dark green on the next call    }
  491.                                 { to this routine.            }
  492.  
  493.                                 LastSet := TermSets[IterIndex];
  494.                                 break;
  495.  
  496.                         end;
  497.                         inc(IterIndex);
  498.  
  499.                 end;
  500.  
  501.         end
  502.  
  503.         { After the last valid depression of the "Step" button, clear    }
  504.         { the truth map and disable the "Step" button.            }
  505.  
  506.         else begin
  507.  
  508.             RestoreMap;
  509.                 StepBtn.Enabled := false;
  510.  
  511.         end;
  512.  
  513.     end;
  514.  
  515. end;
  516.  
  517.  
  518. { OptEqn- This routine optimizes a boolean expression.  This code is    }
  519. { roughly equivalent to the "Step" event handler above except it gener-    }
  520. { ates the optimized equation in a single call rather than in several    }
  521. { distinct calls.                            }
  522.  
  523. procedure OptEqn;
  524. var
  525.     a,b,c,d,
  526.     i        :integer;
  527.  
  528.     TTSet,
  529.     TLeft    :TblSet;
  530.  
  531. begin
  532.  
  533.     with EqnOptimize do begin
  534.  
  535.         { Generate the set of minterms we need to process.    }
  536.  
  537.     TTSet := [];
  538.     for d := 0 to 1 do
  539.             for c := 0 to 1 do
  540.                 for b := 0 to 1 do
  541.                     for a := 0 to 1 do
  542.                     if (tt[d,c,b,a].Caption = '1') then
  543.                         TTSet := TTSet + [ ((b*2+a) xor b) +
  544.                                            ((d*2+c) xor d)*4
  545.                                           ];
  546.         { Special cases for F=1 and F=0    }
  547.  
  548.         if (TTSet = Full) then
  549.         begin
  550.  
  551.             Eqn3.Caption := 'F = 1';
  552.                 Eqn4.Caption := '';
  553.  
  554.         end
  555.         else if (TTSet = []) then
  556.         begin
  557.  
  558.             Eqn3.Caption := 'F = 0';
  559.                 Eqn4.Caption := '';
  560.  
  561.         end
  562.  
  563.         { The following code handles all other equations.  It steps    }
  564.         { through each of the possible patterns and if it finds a    }
  565.         { match it will add its corresponding term to the end of the    }
  566.         { optimized logic equation.                    }
  567.  
  568.         else begin
  569.  
  570.             TLeft := TTSet;
  571.                 Eqn3.Caption := '';
  572.                 Eqn4.Caption := '';
  573.                 for i := 0 to 79 do begin
  574.  
  575.                     if ((TermSets [i] <= TTSet) and
  576.                             ((TermSets [i] * TLeft) <> [])) then begin
  577.  
  578.                             ApndStr('1',TermStrs[i],Eqn3,Eqn4);
  579.                                 TLeft := TLeft - TermSets[i];
  580.  
  581.                         end;
  582.  
  583.                 end;
  584.  
  585.         end;
  586.  
  587.         Eqn3.Caption := 'F = ' + Eqn3.Caption;
  588.  
  589.         { Now that the user has pressed the optimize button, enable    }
  590.         { the "Step" button so they can single step through the opti-    }
  591.         { mization operation.                        }
  592.  
  593.         FirstStep := true;
  594.         StepBtn.Enabled := true;
  595.  
  596.     end;
  597.  
  598. end;
  599.  
  600.  
  601. { The following event handles "Print" button depressions.    }
  602.  
  603. procedure TEqnOptimize.PrintBtnClick(Sender: TObject);
  604. begin
  605.  
  606.     if (PrintDialog.Execute) then
  607.             EqnOptimize.Print;
  608. end;
  609.  
  610. { The following event handles "Exit" button depressions.    }
  611.  
  612. procedure TEqnOptimize.ExitBtnClick(Sender: TObject);
  613. begin
  614.     Halt;
  615. end;
  616.  
  617. { The following event handles "About" button depressions.    }
  618.  
  619. procedure TEqnOptimize.AboutBtnClick(Sender: TObject);
  620. begin
  621.  
  622.     AboutBox.Show;
  623. end;
  624.  
  625. { Whenever the user changes the logic equation, we need to    }
  626. { disable the step button.  The following event does just that    }
  627. { as well as making the "Optimize" button the default operation    }
  628. { when the user presses the "Enter" key.            }
  629.  
  630. procedure TEqnOptimize.LogEqnChange(Sender: TObject);
  631. begin
  632.     OptimizeBtn.Default := true;
  633.         RestoreMap;
  634.         StepBtn.Enabled := false;
  635. end;
  636.  
  637.  
  638. { Whenever the system starts up, the following procedure does    }
  639. { some one-time initialization.                    }
  640.  
  641. procedure TEqnOptimize.FormCreate(Sender: TObject);
  642. begin
  643.  
  644.     { Initialize the tt array so we can use to to access    }
  645.         { the Truth Map as a two-dimensional array.        }
  646.  
  647.     tt[0,0,0,0] := tt00;
  648.     tt[0,0,0,1] := tt01;
  649.     tt[0,0,1,1] := tt02;
  650.     tt[0,0,1,0] := tt03;
  651.  
  652.     tt[0,1,0,0] := tt10;
  653.     tt[0,1,0,1] := tt11;
  654.     tt[0,1,1,1] := tt12;
  655.     tt[0,1,1,0] := tt13;
  656.  
  657.     tt[1,0,0,0] := tt30;
  658.     tt[1,0,0,1] := tt31;
  659.     tt[1,0,1,1] := tt32;
  660.     tt[1,0,1,0] := tt33;
  661.  
  662.     tt[1,1,0,0] := tt20;
  663.     tt[1,1,0,1] := tt21;
  664.     tt[1,1,1,1] := tt22;
  665.     tt[1,1,1,0] := tt23;
  666.  
  667. end;
  668.  
  669. { Whenever the user presses the optimize button, the following    }
  670. { procedure parses the input logic equation, generates a truth    }
  671. { map for it, and then generates the canonical and optimized    }
  672. { equations.                            }
  673.  
  674. procedure TEqnOptimize.OptimizeBtnClick(Sender: TObject);
  675.  
  676. var
  677.     CurChar:integer;
  678.     Equation:string;
  679.  
  680.  
  681.     { Parse- Parses the "Equation" string and evaluates it.    }
  682.     { Returns the equation's value if legal expression, returns    }
  683.     { -1 if the equation is syntactically incorrect.        }
  684.     {                                }
  685.     { Grammar:                            }
  686.     {        S -> X + S | X                    }
  687.     {        X -> YX | Y                    }
  688.     {        Y -> Y' | Z                    }
  689.     {        Z -> a | b | c | d | ( S )            }
  690.  
  691.     function parse(D, C, B, A:integer):integer;
  692.  
  693.         function X(D,C,B,A:integer):integer;
  694.  
  695.             function Y(D,C,B,A:integer):integer;
  696.  
  697.                     function Z(D,C,B,A:integer):integer;
  698.                         begin
  699.  
  700.                                 case (Equation[CurChar]) of
  701.  
  702.                         '(': begin
  703.  
  704.                                     CurChar := CurChar + 1;
  705.                                         Result := parse(D,C,B,A);
  706.                                         if (Equation[CurChar] <> ')') then
  707.                                             Result := -1
  708.                                         else    CurChar := CurChar + 1;
  709.  
  710.                                      end;
  711.  
  712.                                 'a': begin
  713.  
  714.                                     CurChar := CurChar + 1;
  715.                                         Result := A;
  716.  
  717.                                      end;
  718.  
  719.                                 'b': begin
  720.  
  721.                                     CurChar := CurChar + 1;
  722.                                         Result := B;
  723.  
  724.                                      end;
  725.  
  726.                                 'c': begin
  727.  
  728.                                     CurChar := CurChar + 1;
  729.                                         Result := C;
  730.  
  731.                                      end;
  732.  
  733.                                 'd': begin
  734.  
  735.                                     CurChar := CurChar + 1;
  736.                                         Result := D;
  737.  
  738.                                      end;
  739.  
  740.  
  741.                                 '0': begin
  742.  
  743.                                     CurChar := CurChar + 1;
  744.                                         Result := 0;
  745.  
  746.                                      end;
  747.  
  748.  
  749.                                 '1': begin
  750.  
  751.                                     CurChar := CurChar + 1;
  752.                                         Result := 1;
  753.  
  754.                                      end;
  755.  
  756.                                 else Result := -1;
  757.  
  758.                                 end;
  759.                         end;
  760.  
  761.                 begin {Y}
  762.  
  763.                     { Note: This particular operation is left recursive    }
  764.                     { and would require considerable grammar transform-    }
  765.                     { ation to repair.  However, a simple trick is to    }
  766.                     { note that the result would have tail recursion    }
  767.                     { which we can solve iteratively rather than recur-    }
  768.                     { sively.  Hence the while loop in the following    }
  769.                     { code.                        }
  770.  
  771.                     Result := Z(D,C,B,A);
  772.                     while (Result <> -1) and (Equation[CurChar] = '''') do
  773.                     begin
  774.  
  775.                         Result := Result xor 1;
  776.                         CurChar := CurChar + 1;
  777.  
  778.                     end;
  779.                 end;
  780.  
  781.         begin {X}
  782.  
  783.             Result := Y(D,C,B,A);
  784.                 if (Result <> -1) and
  785.                    (Equation[CurChar] in ['a'..'d', '0', '1', '(']) then
  786.                     Result := Result AND X(D,C,B,A);
  787.         end;
  788.  
  789.     begin
  790.  
  791.         Result := X(D,C,B,A);
  792.         if (Result <> -1) and (Equation[CurChar] = '+') then begin
  793.  
  794.             CurChar := CurChar + 1;
  795.             Result := Result OR parse(D, C, B, A);
  796.         end;
  797.  
  798.     end;
  799.  
  800.  
  801. var
  802.     a, b, c, d:integer;
  803.         dest:integer;
  804.         i:integer;
  805.  
  806. begin {ComputeBtnClick}
  807.  
  808.     Equation :=  LowerCase(LogEqn.Text) + chr(0);
  809.  
  810.     { Remove any spaces present in the string }
  811.  
  812.     dest := 1;
  813.     for i := 1 to length(Equation) do
  814.         if (Equation[i] <> ' ') then begin
  815.  
  816.             Equation[dest] := Equation[i];
  817.                 dest := dest + 1;
  818.  
  819.         end;
  820.  
  821.     { Okay, see if this string is syntactically legal.    }
  822.  
  823.     CurChar := 1;    {Start at position 1 in string    }
  824.  
  825.     if (Parse(0,0,0,0) <> -1) then
  826.      if (Equation[CurChar] = chr(0)) then begin
  827.  
  828.         { Compute the values for each of the squares in    }
  829.         { the truth table.                }
  830.  
  831.         for d := 0 to 1 do
  832.           for c := 0 to 1 do
  833.             for b := 0 to 1 do
  834.               for a := 0 to 1 do begin
  835.  
  836.                 CurChar := 1;
  837.                 if (parse(d,c,b,a) = 0) then
  838.                     tt[d,c,b,a].Caption := '0'
  839.                 else    tt[d,c,b,a].Caption := '1';
  840.  
  841.               end;
  842.  
  843.         ComputeEqn;
  844.         OptEqn;
  845.         LogEqn.Color := clWindow;
  846.         RestoreMap;
  847.  
  848.     end
  849.     else LogEqn.Color := clRed
  850.    else LogEqn.Color := clRed;
  851.  
  852.  
  853. end;
  854.  
  855.  
  856. end.
  857.